


;; iconobj.lsp
;; contains code to implement icon objects for the structured GUI
;; this file has code for icon-proto and for data object icon-protos
;; Copyright (c) 1992-99 by Forrest W. Young

(defproto icon-proto 
  '(icon hi-icon grey-icon x y height width title object state window 
         icon-number icon-type moved-p draw graph-hilited stats-hilited null-icon
         graph-icon graph-hi-icon small-grey-icon stats-icon stats-hi-icon
         trans-icon trans-hi-icon model-icon model-hi-icon
         trans-ever-shown? model-ever-shown? 
         graph-ever-shown? stats-ever-shown? deleted? shadowv shadowh undrawn
         title-separation title-back-color title-outline icon-state-changing
         graph-stats-grey-icon stats-not-showable graph-not-showable
         trans-not-showable model-not-showable
         graph-icon-clicked-on stats-icon-clicked-on icon-color freeze
         trans-icon-clicked-on model-icon-clicked-on
         analyze-menu-item-name redraw-order-number))

(defmeth icon-proto :isnew 
  (w x y width height &key (title "Untitled") (draw t) (object nil))
  ;(send self :icon-number (- (send *workmap* :num-icons) 2))
  ;(FORMAT T "ICONOBJ1.LSP|ISNEW - MY ICNUM ~D NICONS ~D" 
  ;        (send self :icon-number)
  ;        (send *workmap* :num-icons))
  (send self :title title)
  (send self :x x)
  (send self :y y)
  (send self :draw draw)
  (send self :width  width)
  (send self :height height)
  (send self :window w)
  (send self :moved-p nil)
  (send self :object (if object object *current-object*))
  (send self :make-shadows)
  )
    
(defmeth icon-proto :analyze-menu-item-name (&optional (string nil set))
  (if set (setf (slot-value 'analyze-menu-item-name) string))
  (slot-value 'analyze-menu-item-name))

(defmeth icon-proto :title (&optional (title nil set))
  (if set (setf (slot-value 'title) title))
  (slot-value 'title))

(defmeth icon-proto :object (&optional (object nil set))
  (if set (setf (slot-value 'object) object))
  (slot-value 'object))

(defmeth icon-proto :x (&optional (val nil set))
  (if set (setf (slot-value 'x) val))
  (slot-value 'x))

(defmeth icon-proto :y (&optional (val nil set))
  (if set (setf (slot-value 'y) val))
  (slot-value 'y))

(defmeth icon-proto :width (&optional (val nil set))
  (if set (setf (slot-value 'width) val))
  (slot-value 'width))

(defmeth icon-proto :height (&optional (val nil set))
  (if set (setf (slot-value 'height) val))
  (slot-value 'height))

(defmeth icon-proto :icon (&optional (matrix nil set))
  (if set (setf (slot-value 'icon) matrix))
  (slot-value 'icon))

(defmeth icon-proto :hi-icon (&optional (matrix nil set))
  (if set (setf (slot-value 'hi-icon) matrix))
  (slot-value 'hi-icon))

(defmeth icon-proto :grey-icon (&optional (matrix nil set))
  (if set (setf (slot-value 'grey-icon) matrix))
  (slot-value 'grey-icon)) 

(defmeth icon-proto :graph-icon (&optional (matrix nil set))
  (if set (setf (slot-value 'graph-icon) matrix))
  (slot-value 'graph-icon))

(defmeth icon-proto :graph-hi-icon (&optional (matrix nil set))
  (if set (setf (slot-value 'graph-hi-icon) matrix))
  (slot-value 'graph-hi-icon))

(defmeth icon-proto :graph-ever-shown? (&optional (logical nil set))
  (if set (setf (slot-value 'graph-ever-shown?) logical))
  (slot-value 'graph-ever-shown?))

(defmeth icon-proto :trans-ever-shown? (&optional (logical nil set))
  (unless (send self :has-slot 'trans-ever-shown?)
          (send self :add-slot 'trans-ever-shown?))
  (if set (setf (slot-value 'trans-ever-shown?) logical))
  (slot-value 'trans-ever-shown?))

(defmeth icon-proto :model-ever-shown? (&optional (logical nil set))
  (unless (send self :has-slot 'model-ever-shown?)
          (send self :add-slot 'model-ever-shown?))
  (if set (setf (slot-value 'model-ever-shown?) logical))
  (slot-value 'model-ever-shown?))

(defmeth icon-proto :graph-not-showable (&optional (logical nil set))
  (if set (setf (slot-value 'graph-not-showable) logical))
  (slot-value 'graph-not-showable))

(defmeth icon-proto :stats-not-showable (&optional (logical nil set))
  (if set (setf (slot-value 'stats-not-showable) logical))
  (slot-value 'stats-not-showable))

(defmeth icon-proto :model-not-showable (&optional (logical nil set))
  (if set (setf (slot-value 'model-not-showable) logical))
  (slot-value 'model-not-showable))

(defmeth icon-proto :trans-not-showable (&optional (logical nil set))
  (if set (setf (slot-value 'trans-not-showable) logical))
  (slot-value 'trans-not-showable))

(defmeth icon-proto :stats-icon (&optional (matrix nil set))
  (if set (setf (slot-value 'stats-icon) matrix))
  (slot-value 'stats-icon))

(defmeth icon-proto :stats-hi-icon (&optional (matrix nil set))
  (if set (setf (slot-value 'stats-hi-icon) matrix))
  (slot-value 'stats-hi-icon))

(defmeth icon-proto :stats-ever-shown? (&optional (logical nil set))
  (if set (setf (slot-value 'stats-ever-shown?) logical))
  (slot-value 'stats-ever-shown?))

(defmeth icon-proto :trans-icon (&optional (matrix nil set))
  (if set (setf (slot-value 'trans-icon) matrix))
  (slot-value 'trans-icon))

(defmeth icon-proto :trans-hi-icon (&optional (matrix nil set))
  (if set (setf (slot-value 'trans-hi-icon) matrix))
  (slot-value 'trans-hi-icon))

(defmeth icon-proto :model-icon (&optional (matrix nil set))
  (if set (setf (slot-value 'model-icon) matrix))
  (slot-value 'model-icon))

(defmeth icon-proto :model-hi-icon (&optional (matrix nil set))
  (if set (setf (slot-value 'model-hi-icon) matrix))
  (slot-value 'model-hi-icon))

(defmeth icon-proto :deleted? (&optional (logical nil set)) 
  (if set (setf (slot-value 'deleted?) logical))
  (slot-value 'deleted?))

(defmeth icon-proto :small-grey-icon (&optional (matrix nil set))
  (if set (setf (slot-value 'small-grey-icon) matrix))
  (slot-value 'small-grey-icon))

(defmeth icon-proto :graph-stats-grey-icon (&optional (logical nil set))
  (if set (setf (slot-value 'graph-stats-grey-icon) logical))
  (slot-value 'graph-stats-grey-icon))

(defmeth icon-proto :null-icon (&optional (matrix nil set))
  (if set (setf (slot-value 'null-icon) matrix))
  (slot-value 'null-icon))

(defmeth icon-proto :window (&optional (window nil set))
  (if set (setf (slot-value 'window) window))
  (slot-value 'window)) 

(defmeth icon-proto :icon-number (&optional (number nil set))
;(format t "~%; ICONOBJ1|ICON-NUMBER ~a" number)
  (if set (setf (slot-value 'icon-number) number))
  (slot-value 'icon-number)) 

(defmeth icon-proto :redraw-order-number (&optional (number nil set))
  (if set (setf (slot-value 'redraw-order-number) number))
  (slot-value 'redraw-order-number)) 

(defmeth icon-proto :icon-type (&optional (number nil set))
  (if set (setf (slot-value 'icon-type) number))
  (slot-value 'icon-type)) 

(defmeth icon-proto :icon-color (&optional (number nil set))
  (if set (setf (slot-value 'icon-color) number))
  (slot-value 'icon-color))

(defmeth icon-proto :moved-p (&optional (logical nil set))
  (if set (setf (slot-value 'moved-p) logical))
  (slot-value 'moved-p))

(defmeth icon-proto :draw (&optional (logical nil set))
  (if set (setf (slot-value 'draw) logical))
  (slot-value 'draw))

(defmeth icon-proto :trans-hilited (&optional (logical nil set))
  (unless (send self :has-slot 'trans-hilited)
          (send self :add-slot 'trans-hilited))
  (if set (setf (slot-value 'trans-hilited) logical))
  (slot-value 'trans-hilited))

(defmeth icon-proto :model-hilited (&optional (logical nil set))
  (unless (send self :has-slot 'model-hilited)
          (send self :add-slot 'model-hilited))
  (if set (setf (slot-value 'model-hilited) logical))
  (slot-value 'model-hilited))

(defmeth icon-proto :graph-hilited (&optional (logical nil set))
  (if set (setf (slot-value 'graph-hilited) logical))
  (slot-value 'graph-hilited))

(defmeth icon-proto :stats-hilited (&optional (logical nil set))
  (if set (setf (slot-value 'stats-hilited) logical))
  (slot-value 'stats-hilited))

(defmeth icon-proto :draw-color (&optional (draw-color nil set))
  (if set (setf (slot-value 'draw-color) draw-color))
  (slot-value 'draw-color))

(defmeth icon-proto :shadowv (&optional (matrix nil set))
  (if set (setf (slot-value 'shadowv) matrix))
  (slot-value 'shadowv))

(defmeth icon-proto :shadowh (&optional (matrix nil set))
  (if set (setf (slot-value 'shadowh) matrix))
  (slot-value 'shadowh))

(defmeth icon-proto :title-separation (&optional (num-pixels nil set))
  (if set (setf (slot-value 'title-separation) num-pixels))
  (slot-value 'title-separation))

(defmeth icon-proto :title-back-color (&optional (color-symbol nil set))
  (if set (setf (slot-value 'title-back-color) color-symbol))
  (slot-value 'title-back-color))

(defmeth icon-proto :title-outline (&optional (logical nil set))
  (if set (setf (slot-value 'title-outline) logical))
  (slot-value 'title-outline))

(defmeth icon-proto :icon-state (&optional (state nil set))
  (if set (setf (slot-value 'state) state))
  (slot-value 'state))

(defmeth icon-proto :state (&optional (state nil set))
  (when set (setf (slot-value 'state) state))
  (slot-value 'state))

(defmeth icon-proto :icon-state-changing (&optional (logical nil set))
  (if set (setf (slot-value 'icon-state-changing) logical))
  (slot-value 'icon-state-changing))

(defmeth icon-proto :undrawn (&optional (logical nil set))
  (if set (setf (slot-value 'undrawn) logical))
  (slot-value 'undrawn))

(defmeth icon-proto :freeze (&optional (logical nil set))
  (if set (setf (slot-value 'freeze) logical))
  (slot-value 'freeze))

(defmeth icon-proto :graph-icon-clicked-on (&optional (logical nil set))
  (if set (setf (slot-value 'graph-icon-clicked-on) logical))
  (slot-value 'graph-icon-clicked-on))

(defmeth icon-proto :stats-icon-clicked-on (&optional (logical nil set))
  (if set (setf (slot-value 'stats-icon-clicked-on) logical))
  (slot-value 'stats-icon-clicked-on))

(defmeth icon-proto :trans-icon-clicked-on (&optional (logical nil set))
  (if set (setf (slot-value 'trans-icon-clicked-on) logical))
  (slot-value 'trans-icon-clicked-on))

(defmeth icon-proto :model-icon-clicked-on (&optional (logical nil set))
  (if set (setf (slot-value 'model-icon-clicked-on) logical))
  (slot-value 'model-icon-clicked-on))

(defmeth icon-proto :enabled (&optional (logical nil set) &key (draw t))
  (when set 
        (when (not (equal (send self :state) (if logical "normal" "gray")))
              (send self :state (if logical "normal" "gray"))
              (send self :show-icon (send self :state) :draw draw)))
  (not (equal (send self :state) "gray")))
  
(defmeth icon-proto :make-shadows ()
  (when (send self :icon)
  (let* ((size (array-dimensions (send self :icon)))
         (r (first size))
         (c (second size)))
    (send self :shadowv (matrix (list r 1) (repeat 1 r)))
    (send self :shadowh (matrix (list 1 c) (repeat 1 c)))
    )))

(defmeth icon-proto :make-icon (icon-type x y title)
  (let ((w (send self :window))
        (sob (send self :object))
        (icon-obj))
    (case icon-type
      (1 (setf icon-obj (send dob-icon-proto :new w x y 25 32 :title title))
         (when (send sob :missing-values) (send self :not-showable t)))
      (3 (setf icon-obj (send mob-icon-proto :new w x y 25 32 :title title))
         (send w :draw-color 'model-icon-color))
      (4 (setf icon-obj (send dib-icon-proto :new w x y 25 32 :title title)))
      (5 (setf icon-obj (send tab-icon-proto :new w x y 25 32 :title title))))
    icon-obj))
  
(defmeth icon-proto :do-click (&optional (click-type nil))
"Arg: CLICK-TYPE can be nil or the strings 
\"graph\" \"stats\" \"transf\" \"model\" \"main\"."
  (let* ((numnow (position self (send *workmap* :icon-list) :test #'equal))
         (num (send *workmap* :selected-icon))
         (icon-type (send self :icon-type))
         (prev (select (send *workmap* :icon-list) num))
         (draw t)
         (wind (send self :window))
         (prev-icon-type (send prev :icon-type)))
    (unless (equal self prev)
            (send prev :icon-state "normal")
            (send prev :icon-state-changing nil)
            (send prev :turn-title-off)
            (send prev :draw-title "normal")
            (send prev :show-icon "normal" :draw draw)
            (send self :icon-state "selected")
            (send self :icon-state-changing nil)
            ;(send self :turn-title-off)
            (send self :draw-title "selected")
            (send *workmap* :select-icon numnow :draw nil))
    (send prev :set-buttons click-type t)
    (send prev :show-icon "normal" :draw t)
    (send self :set-buttons click-type nil)
    (send self :show-icon "selected" :draw t)
    (send *workmap* :previously-selected-icon num)
    t))

#|
(defmeth icon-proto :redraw (state)
  (send self :draw (send self :state)))

(defmeth icon-proto :draw (state)
  (let ((icon-type (send self :icon-type))
        (data-icon? (or (= icon-type 1) 
                        (= icon-type 4) 
                        (= icon-type 5)))
        (model-icon? (= icon-type 3)))
    (when (equal state "selected")
          (send (send *workmap* :selected-icon-object) :draw "normal"))
    (send self :draw-title state)
    (send self :buttons-off)
    (when (or model-icon? data-icon?)
          (send self :draw-stats-icon 
                (equal "selected" state)
                (send self :stats-ever-shown))
          (send self :draw-graph-icon 
                (equal "selected" state) 
                (send self :graph-ever-shown)))
    (when data-icon?
          (send self :draw-trans-icon 
                (equal "selected" state)
                (send self :trans-ever-shown))
          (send self :draw-model-icon 
                (equal "selected" state)
                (send self :model-ever-shown)))
    (send self :show-icon state :draw t)))
|#


(defmeth icon-proto :redraw ()
  (let ((state (send self :state))
        (icon-type (send self :icon-type))
        (data-icon? (or (= icon-type 1) 
                        (= icon-type 4) 
                        (= icon-type 5)))
        (model-icon? (= icon-type 3)))
    (when (equal state "selected")
          (send self :turn-title-off))
    (send self :draw-title state)
    (send self :buttons-off)
    (when (or model-icon? data-icon?)
          (send self :draw-stats-icon 
                (equal "selected" state)
                (send self :stats-ever-shown))
          (send self :draw-graph-icon 
                (equal "selected" state) 
                (send self :graph-ever-shown)))
    (when data-icon?
          (send self :draw-trans-icon 
                (equal "selected" state)
                (send self :trans-ever-shown))
          (send self :draw-model-icon 
                (equal "selected" state)
                (send self :model-ever-shown))))
  (send self :show-icon state :draw t))


(defmeth icon-proto :set-buttons (click-type &optional (medium-hi-icon nil))
"Args: click-type &optional (hi-icon t)
Set states of all of the buttons of a data or model icon when a button is clicked on. The clicked-on button might be for a different icon. Click-type indicates which button (\"stats\" \"graph\" \"transf\" \"model\") is clicked on. Hi-icon is t if this icon is the one being clicked on (and therefore is or will be \"turned on\" - being hilited), and is nil if another icon is being clicked on (and therefore this is an icon being \"turned off\" - being downlited). In the former case buttons are either hilited or lowlited. In the later they are mediumlited or lowlited."
  (let* ((icon-type (send self :icon-type))
         (data-icon? (or (= icon-type 1) 
                        (= icon-type 4) 
                        (= icon-type 5)))
        (model-icon? (= icon-type 3)))
    ;(print (list "data icon" data-icon? "ever shown" (send self :trans-ever-shown?) 
    ;             "click type" (equal click-type "transf")))
    ;(format t "~a" (strcat "A - " (send self :title)))
    (when (or model-icon? data-icon?)
          (when
           (or (send self :graph-ever-shown?)
               (equal click-type "graph"))
           (send self :draw-graph-hi-icon medium-hi-icon)
           ;  (pause 30)                       ;these two statements make the icon
           ;  (send self :draw-graph-icon)     ;work like a button (briefly highlites)
           (send self :graph-ever-shown? t) ;this makes it work like an icon (remembers state)
           )
          (when
           (or (send self :stats-ever-shown?)
               (equal click-type "stats") )
           (send self :draw-stats-hi-icon medium-hi-icon)
           ; (pause 30)
           ;(send self :draw-stats-icon hi )
           (send self :stats-ever-shown? t)
           ))
    (when data-icon?
;(format t "~a" (strcat "B - " (send self :title)))
          (when
           (or (send self :model-ever-shown?)
               (equal click-type "model") )
           (send self :draw-model-hi-icon medium-hi-icon)
           ;  (pause 30)
           ;  (send self :draw-model-icon)
           (send self :model-ever-shown? t)
           )
          (when
           (or (send self :trans-ever-shown?)
               (equal click-type "transf") )
           (send self :draw-trans-hi-icon medium-hi-icon)
           ; (pause 30)
           ; (send self :draw-trans-icon)
           (send self :trans-ever-shown? t)
           ))
    t))
    
(defmeth icon-proto :buttons-off ()
  (send self :draw-graph-icon) 
  (send self :draw-model-icon)
  (send self :draw-stats-icon)
  (send self :draw-trans-icon))
